home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Camelot / Camelot 098 (1990-12)(Swedish User Group of Amiga)(SE)(PD)[WB].zip / Camelot 098 (1990-12)(Swedish User Group of Amiga)(SE)(PD)[WB].adf / XLisp-Stat / Book / kernelsmooth.lsp < prev    next >
Text File  |  1990-10-11  |  1KB  |  39 lines
  1. ; book pp.304-306
  2.  
  3. (require "data/tutorial")
  4.  
  5. (setf w (plot-lines (kernel-dens precipitation :width 1)))
  6.  
  7. (send w :add-slot 'kernel-width 1)
  8. (send w :add-slot 'kernel-type 'b)
  9. (defmeth w :kernel-width (&optional width)
  10.   (when width
  11.         (setf (slot-value 'kernel-width) width)
  12.         (send self :set-lines))
  13.      (slot-value 'kernel-width))
  14. (defmeth w :kernel-type (&optional type)
  15.   (when type
  16.         (setf (slot-value 'kernel-type) type)
  17.         (send self :set-lines))
  18.      (slot-value 'kernel-type))
  19.  
  20. (defmeth w :set-lines ()
  21.   (let ((width (send self :kernel-width))
  22.         (type (send self :kernel-type)))
  23.     (send self :clear-lines :draw nil)
  24.     (send self :add-lines
  25.           (kernel-dens precipitation
  26.                        :width width :type type))))
  27. (setf slider (interval-slider-dialog '(.25 1.5)
  28.                      :action #'(lambda (s) (send w :kernel-width s))))
  29. (send w :add-subordinate slider)
  30. (send slider :value 1)
  31.  
  32. (defmeth w :choose-kernel ()
  33.   (let* ((types '("Bisquare" "Gaussian" "Triangle" "Uniform"))
  34.          (i (choose-item-dialog "Kernel Type" types)))
  35.     (if i (send w :kernel-type (select '(b g t u) i)))))
  36. (setf kernel-item (send menu-item-proto :new "Kernel Type"
  37.       :action #'(lambda () (send w :choose-kernel))))
  38. (send (send w :menu) :append-items kernel-item)
  39.